00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES. SEE PT1.CMD
00200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,JPQ
00300		1 /IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),
00400		1 RCLEF(-3/4) /IVV/NRD(100)
00500		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700		COMMON/XRN/RN(3000) /SF/KL,RT,KP,STFSZ,NAMX,EXT
00800		1 /PTR/KWDS(250)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900	C  INCREASE DIMENSION OF KWDS (KPN & Q) FOR VERY FULL PAGES.
01000	CC    DIMENSION MM(1500),NN(1500),BARS(509),IWDS(1),STFNM(0/4),
01100	      DIMENSION MM(1500),NN(1500),BARS(509),STFNM(0/4),
01200		1 RSIG(-3/4),RMETER(-3/4),RCL(-3/4)
01300		COMMON /PX/KPN(350) /Q/Q(3500) /KBAR/KBAR(512) 
01400	 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500		1 /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
01600		DATA FIB/.7/,RSPC/25./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700		1 ,RLTRSZ/1.0/,SPCPG/2.7/
01800		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01900		1,(MM,RN),(NN,RN(1501)),(KS,RS),(BARS,KBAR(4)),(IWDS,KBAR(4))
02000		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02100		1,(STFNM,KBAR(508))
02200	C  RQ(2) IS R4, RQ(3) IS R5 ETC.  STAFF NAMES START AT KBAR(508)=STF(0)
02300	
02400		JNM=1
02500		KBR=0
02600		NMPG='PAGEA'
02700		JRD=0
02800		ENDLN=0
02900		SAVSIZ=0
03000	
03100		TYPE 3
03200		ACCEPT 2,KS,NTYPE
03300	CC	CALL NAMEXT
03400	2	FORMAT(A5,30I)
03500	3	FORMAT(' TYPE FILE NAME -- '$)
03600	C  TYPE -1 AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
03700	CC	IPG=NTYPE-1
03800	CC	IPG=0
03900	C TYPE 1 AFTER NAME FOR 'PAGE' LAYOUT
04000		IF(KS.EQ.' ')KS='OLD'
04100		IF(KS.EQ.'OLD')CALL PT2
04200	CP	IF(IPG)GO TO 144
04300	CX	KNM(1)=KS
04400		NAMZ=KS
04500	CX	JNM=2
04600		JNM=1
04700	CC	DO 644 K=1,100
04800	C NO EDIT FILE NEEDED FOR PAGE LAYOUT INPUT!!!   TYPE 'NAME' 1
04900	CC644	NRD(K)=1
05000	
05100	143	CALL IFILE(1,KS)
05200		READ(1,243)EXT
05300	C  FIRST LINE MUST BE EXTENSION NAME
05400	243	FORMAT(A5,30I)
05500	543	READ(1,243,END=343),KNM(JNM),(KPN(K),K=1,30)
05600		JNM=JNM+1
05700		DO 434 K=1,30
05800		J=KPN(K)
05900		JRD=JRD+1
06000		NRD(JRD)=J
06100	434	IF(J.EQ.0)GO TO 543
06200	
06300	343	KNM(JNM)='ZZZZZ'
06400	CP	IF(IPG)GO TO 744
06500		DO 911 K=1,8
06600		RCLEF(K-4)=99
06700		RCL(K-4)=99
06800		RMETER(K)=99
06900	C  INITS STUFF FOR PAGE LAYOUT
07000	911	RSIG(K)=99
07100		BRACK=0
07200	744	XSIG=FIB
07300		CLEF=-1
07400		XMTR=FIB
07500		XLFT=0
07600		JPG=0
07700		YCLEF=2.
07800		YSIG=2.
07900		YMTR=2.
08000		RSTAFF=0
08100		RM=0
08200	1344	JNM=1
08300		IPG=-1
08400	
08500	CC	XMTR=FIB
08600	CC	XLFT=0
08700	CC	JPG=0
08800	CC	YCLEF=2.
08900	CC	YSIG=2.
09000	CC	YMTR=2.
09100	CC	RSTAFF=0
09200	CC	RM=0
09300	
09400		KQ=0
09500		JRD=0
09600		L=1
09700		LK=1
09800	86	FORMAT(1XA5)
09900	186	FORMAT(1XA5,'.',A3)
10000	
10100	83	NAME=KNM(JNM)
10200		JNM=JNM+1
10300		IF(NAME.EQ.'ZZZZZ')GO TO 20
10400		JRD=JRD+1
10500		NXX=NRD(JRD)
10600	CC	NAMZ=NAME
10700		IF(KBR.EQ.0)GO TO 284
10800		JZ=-1
10900	10	IF(LOOKX(NAME,EXT))GO TO 284
11000		IF(JZ)GO TO 344
11100	C  FOUND NO MORE TO READ
11200	1212	CALL PUTEXT('BARS','PAG')
11300		CALL EXTOUT(KBAR,512)
11400		RSTJ2=SAVSIZ
11500		CALL EXTOUT(RSTFAC,128)
11600		CALL FINEXT
11700	C K (NUM OF BARS - UP TO 511) IS FIRST LOC OF KBAR.
11800		CALL PT2(KPN,Q,KWDS,RN)
11900	344	NAME=NAMZ+256
12000		NAMZ=NAME
12100		JZ=0
12200		IF(LOOKX(NAME,EXT).GE.0)GO TO 10
12300		KNM(1)=NAME
12400	284	JZ=0
12500		SN=0
12600		IF(IPG)SN=200
12700		SNMTR=SN
12800		IF(RM.NE.0)GO TO 277
12900		RM=-1
13000	4	FORMAT(' TYPE INST NAME  '$)
13100		TYPE 4
13200		ACCEPT 2,RNAM,K
13300		RNAM2=0
13400		RNAM3=0
13500		RNAM4=0
13600		IF(K.EQ.0)GO TO 277
13700		TYPE 177
13800		ACCEPT 2,RNAM2,K
13900		IF(K.EQ.0)GO TO 277
14000	C  TYPE NUM AFTER NAME TO ENTER UP TO 4 NAMES.
14100		TYPE 177
14200		ACCEPT 2,RNAM3
14300		TYPE 177
14400		ACCEPT 2,RNAM4
14500	177	FORMAT(' OTHER INST NAME   ',$)
14600	
14700	
14800	277	TYPE 186,NAME,EXT
14900		CALL GETEXT(NAME,EXT)
15000	C  LP IS START OF RN ARRAY THIS TIME
15100		CALL EXTIN(RSTFAC,20)
15200		CALL EXTIN(KWDS,JJ2)
15300		CALL EXTIN(RN,JPQ)
15400		IF(SAVSIZ.EQ.0)SAVSIZ=RSTJ2
15500		IPG=-1
15600	C  IPG MUST BE RESET EACH TIME BECAUSE READIN WIPES IT OUT.
15700	
15800	C  PUT RN INTO Q, JPQ=WDCNT
15900		CALL RLOOP(Q,RN,JPQ)
16000		ITEM=JJ2-2
16100	1211	R=RN(KWDS(1)+3)
16200		K=2
16300		J=0
16400	1111	IF(RN(KWDS(K)+1).GT.2)GO TO 2611
16500	C  SORTS NOTES AND RHYTH ONLY
16600		RA=RN(KWDS(K)+3)
16700		IF(RA.GE.R)GO TO 1011
16800		CALL EXCH(KWDS(K),KWDS(K-1))
16900		J=-1
17000	1011	R=RA
17100	2611	K=K+1
17200		IF(K.LE.ITEM)GO TO 1111
17300		IF(J)GO TO 1211
17400	C NOW ALL SORTED
17500		J=1
17600		KW=1
17700		DO 1311 K=1,ITEM
17800		LS=KWDS(K)
17900		IF(RN(LS+1).GT.2)GO TO 2711
18000		RN(LS+3)=RN(LS+3)-.001
18100	C  MOVE ALL NOTES AND RESTS SLIGHTLY TO LEFT. (FOR SORTER)
18200	CX2711	M=RN(LS)+2
18300	2711	M=RN(LS)+3
18400	CX	DO 1411 N=LS,M+LS
18500	CX	Q(J)=RN(N)
18600	CX1411	J=J+1
18700		CALL RLOOP(Q(J),RN(LS),M)
18800		J=J+M
18900		KPN(K)=KW
19000	1311	KW=KW+M
19100		KPN(ITEM+1)=KW
19200	CC	DO 1511 K=1,ITEM+1
19300	CC1511	KWDS(K)=KPN(K)
19400	CC	DO 1611 K=1,JPQ
19500	CC1611	RN(K)=Q(K)
19600		CALL BLTEM
19700	C  BLTEM BLTS ARRAYS KPN AND Q INTO KWDS AND RN
19800	811	DO 577 K=1,ITEM
19900	CC	J=KWDS(K)
20000	CC	R=RN(J+1)
20100		R=CODEN(KWDS,K,RN,J)
20200		RWD=RN(J)
20300	C RWD IS WDCNT OF EACH ITEM
20400	CP	IF(IPG)GO TO 111
20500	C IPG=-1 = EXTRACTING PARTS, =0  = PAGE LAYOUT.
20600	
20700		GO TO 111
20800	
20900		IF(R.NE.8)GO TO 211
21000		LS=RN(J+2)
21100		STFNM(LS)=0
21200		IF(RWD.LT.7)GO TO 1811
21300		STFNM(LS)=RN(J+9)
21400	1811	IF(ENDLN.NE.0)GO TO 211
21500		JPG=JPG+1
21600		R5=RN(J+2)
21700		RSTNUM(JPG)=R5
21800		RHGT(JPG)=0
21900	 	IF(RWD.GE.2)RHGT(JPG)=RN(J+4)
22000		RPSZ(JPG)=RSTFAC(IFIX(R5))
22100	C***211	RN(J+2)=RN(J+2)*.1
22200	C*** STAFF NUMS WILL NOW BE -.3 UP TO +.4. NO STAFF NAME NEEDED.
22300		IF(R5.EQ.0)SPCNT=SPCPG*RPSZ(JPG)
22400	211	IF(R.NE.4)GO TO 577
22500		IF(RN(J+3).GT.0)GO TO 577
22600		IF(RWD.GE.5)BRACK=RN(J+7)
22700	C  SAVE 'BRACKET' INFO (P7=3,4 OR 5) - CAN FIND WRONG THING!!
22800		GO TO 577
22900	111	IF(R.NE.8)GO TO 677
23000		IF(RWD.LT.7)GO TO 577
23100	C  NO NAME ON THIS STAFF - SO JUMP
23200		IF(RN(J+7).NE.0)GO TO 577
23300	C  SKIPS INVISIBLE STAVES.
23400		XLFT=RN(J+3) 
23500	C LEFT LIMIT OF STAFF
23600		R9=RN(J+9)
23700		IF(NTYPE)TYPE 86,R9
23800		IF(R9.EQ.RNAM)GO TO 977
23900		IF(RNAM2.EQ.R9)GO TO 977
24000		IF(RNAM3.EQ.R9)GO TO 977
24100		IF(RNAM4.NE.R9)GO TO 577
24200	977	I=RN(J+2)+RSTAFF
24300		SN=I
24400		SNMTR=SN
24500		GO TO 477
24600	677	IF(R.NE.10)GO TO 577
24700		IF(RWD.LT.4)GO TO 577
24800		IF(RN(J+6).GT.RNUM)GO TO 577
24900	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
25000	CC??	IF(RWD.GE.6)P=-1
25100	C  FOUND A NUM. IN BOX ↑↑, REMEMBER IT DID.
25200		GO TO 577
25300		IF(IPG.EQ.0)GO TO 477
25400	CC79	IF(R.NE.16)GO TO 577
25500	CC??	IF(RN(J+5).GE.100)P=-1
25600	C  PICKS UP WORD WITH SZ >100
25700	577	CONTINUE
25800	C  DIDN'T FIND USEFUL INFO SO SKIP THIS FILE
25900	
26000	477	I=JPQ-2
26100	C READS AND WRITES 1 EXTRA WORD
26200	CP	IF(IPG.EQ.0)GO TO 13
26300	
26400	877	NXX=NXX-1
26500		NAME=NAME+2
26600		IF(NXX.NE.0)GO TO 277
26700		JRD=JRD+1
26800		NXX=NRD(JRD)
26900		IF(NXX.NE.0)GO TO 44
27000		NAME=0
27100		NAMZ=0
27200	CC44	KX=1
27300	C ****** RSTAFF NOT NEEDED IN THIS FORM OF PROG.
27400	44	RSTAFF=0
27500	CC	IWDS(1)=1
27600	13	YN=0
27700		IF(SN.NE.200)GO TO 8
27800		YN=-1
27900		IF(YCLEF.GT.1)YCLEF=-1
28000		IF(YSIG.GT.1)YSIG=-1
28100		IF(YMTR.GT.1)YMTR=-1
28200	
28300	8	ZLFT=XLFT+.5
28400		RNUM=PGNUM
28500	C  SIZE FACTOR FOR PAGE NUMBER FINDER (MAYBE).
28600	
28700		DO 6 K=1,ITEM
28800		R5=-1
28900	CC	J=KWDS(K)
29000	CC	R=RN(J+1)
29100		R=CODEN(KWDS,K,RN,J)
29200		IF(R.EQ.0)GO TO 6
29300	C  DUPLICATE BARS WERE CHANGED TO CODE 0
29400		RWD=RN(J)
29500	C RWD IS WDCNT OF EACH ITEM
29600		IF(R.NE.10)GO TO 800
29700		IF(RWD.LT.4)GO TO 80
29800		IF(RN(J+6).GT.RNUM)GO TO 6
29900	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
30000		IF(RWD.LT.6)GO TO 80
30100	
30200		RN(J+6)=RNMSZ
30300	
30400		RN(J+4)=RNMHT
30500	C  THE ABOVE SET HEIGHT AND SIZE OF REHEARSAL NUMS.
30600		GO TO 810
30700	800	IF(R.NE.4)GO TO 80
30800		IF(RWD.NE.2)GO TO 182
30900	C  FOUND A BAR LINE
31000		RN(J+4)=1
31100		IF(RN(J+3).LT.ZLFT)GO TO 6
31200	C DROPS BAR LINE AT LEFT OF STAFF.
31300		CALL DBAR(K,ITEM,J)
31400		IF(YN.EQ.0)GO TO 810
31500		CALL ADRST(KPN)
31600		GO TO 6
31700	182	RN(J+1)=44
31800	C  CHANGES CODE NUM 
31900		IF(RWD.LT.5)GO TO 80
32000		IF(RN(J+7).GE.3)GO TO 6
32100	C  SKIP HEAVY BRACKETS.
32200		IF(RWD.LT.4)GO TO 80
32300		A=RN(J+6)
32400		IF(A.EQ.0)GO TO 80
32500		IF(A.GE.199)RN(J+6)=200
32600	80	IF(R.NE.16)GO TO 180
32700	CP	IF(IPG.EQ.0)GO TO 180
32800		IF(RN(J+5).GE.100)RN(J+2)=SN
32900	C CATCHES WANTED TEXT ON OTHER LINES.  (P5>100)
33000		IF(RN(J+5).GT.RLTRSZ)RN(J+5)=RLTRSZ
33100	C  LIMITS SIZE OF LETTERS.  ADJUST RLTRSZ TO SUIT. (SET AT 1.0 NOW)
33200	180	RSN=RN(J+2)
33300	CP	IF(IPG)GO TO 2011
33400	CP	ISN=RSN
33500	CP	RSN=SN
33600	C  THE STAFF NUM.
33700	2011	IF(R.NE.3)GO TO 3801
33800	CP	IF(IPG)GO TO 2111
33900	CP	CLEF=RCL(ISN)
34000	CP	GO TO 4801
34100	2111	IF(YCLEF)GO TO 4801
34200		IF(RSN.NE.SN)GO TO 6
34300	CC4801	RR=AMOD(RN(J+5),100.0)
34400	C    ↑↑↑↑↑ BECAUSE SOME CLEFS ARE MINI-CLEFS
34500	CC	IF(RN(J).LT.3)RR=0
34600	4801	RR=CLEFN(RN,J)
34700	C  GET CLEF NUMBER.
34800		IF(RR.EQ.CLEF)GO TO 6
34900	C SKIP DUPLICATE CLEFS.
35000		IF(RR.GT.3)GO TO 4800
35100	
35200	CX	GO TO 17
35300	
35400	CP	IF(IPG)GO TO 16
35500	CP	RCL(ISN)=RR
35600	CP	IF(RCLEF(ISN).EQ.99)RCLEF(ISN)=RR
35700	C  SAVE FIRST CLEF ON EACH STAFF
35800	CP	GO TO 1800
35900	CX16	FORMAT(' CLEF=',F2.0,' --CHANGE TO--',$)
36000	CX	TYPE 16,RR
36100	CX5	FORMAT(F)
36200	CX	ACCEPT 5,RR
36300	17 	R5=RR
36400		CLEF=RR
36500		YCLEF=0
36600		GO TO 1800
36700	4800	IF(RSN.NE.SN)GO TO 6
36800		RN(J+1)=33
36900		GO TO 1800
37000	4802	YCLEF=0
37100	C  CATCHES CLEF AFTER FIRST RESTS.
37200		GO TO 6
37300	3801	IF(R.NE.17)GO TO 3800
37400	CP	IF(IPG)GO TO 2211
37500	CP	XSIG=RSIG(ISN)
37600	CP	GO TO 3802
37700	2211	IF(YSIG)GO TO 3802
37800		IF(RSN.NE.SN)GO TO 6
37900	3802	RR=RN(J+5)
38000		IF(RR.EQ.XSIG)GO TO 6
38100		YSIG=0
38200		XSIG=RR
38300	C SKIPS DUPL. KEY SIGS.
38400	CP	IF(IPG.EQ.0)RSIG(ISN)=RR
38500		GO TO 1800
38600	3800	IF(R.EQ.8)GO TO 6
38700	C  OMIT ALL STAVES FOR NOW
38800		IF(R.NE.18.)GO TO 81
38900	CP	IF(IPG)GO TO 2311
39000		XMTR=RMETER(ISN)
39100		GO TO 1801
39200	2311	IF(YMTR)GO TO 1801
39300		IF(SNMTR.EQ.200.)SNMTR=RSN
39400	C  SO IT WON'T REPEAT METERS.
39500	C  CHECK ALL METERS IF LINE HAS NOT THIS INST.
39600		IF(RSN.NE.SNMTR)GO TO 6
39700	1801	RA=RN(J+5)*100.+RN(J+6)
39800	C  THE TIME SIG.
39900		IF(XMTR.EQ.RA)GO TO 6
40000		XMTR=RA
40100		YMTR=0
40200		IF(IPG.EQ.0)RMETER(ISN)=RA
40300		GO TO 1800
40400	81	IF(RSN.NE.SN)GO TO 6
40500	1800	IF(RN(J+3).LT.XLFT)GO TO 6
40600	C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
40700	CP1800	IF(R.NE.7)GO TO 282
40800		IF(RWD.LT.5)GO TO 810
40900		A=ABS(RN(J+7))
41000		IF(A.LT.2.OR.A.GT.7)GO TO 82
41100	C  CATCHES TRILL WIGGLE OVER END OF LINE.
41200	282	IF(R.NE.5)GO TO 810
41300	C NEXT CHECKS FOR SLUR OVER END OF LINE
41400	82	IF(RN(J+6).GE.199.)RN(J+6)=200.
41500	C  ****** 200.0 ABOVE IS SUBJECT TO CHANGE!
41600	810	KL=0
41700		IF(R.GT.2)GO TO 1810
41800	C NEXTS FINDS NOTES AND RESTS WITHOUT RHYTHM (P7 OR P9)
41900		IF(RN(J+3)-PQ.GT.SPCPG)GO TO 1810
42000	C  JUMP IF NOT IN SAME VERT. POS.
42100		IF(RT.NE.R)GO TO 1810
42200	C JUMP IF PREVIOUS ITEM WASN'T THE SAME
42300		RS=9-R*2
42400		IF(RWD.GE.RS)GO TO 1810
42500	C JUMP IF WDCNT IS BIG ENOUGH
42600		KL=RS-RWD
42700	C  SEND THE DIFFERENCE TO THE SUBROUTINE AND ADD A RHYTHM (1.0)
42800	1810	RN(J+2)=0
42900	C  FOR PARTS PUT ALL ON STAFF 0.
43000		CALL QRN(J,KPN,K)
43100	C  PUTS NEEDED THINGS INTO Q ARRAY
43200		RT=R
43300	C  WHAT'S THIS FOR ↑↑?
43400		PQ=RN(J+3)
43500	C SAVE THINGS FOR NEXT TIME AROUND LOOP.
43600	6	CONTINUE
43700	
43800	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
43900		CALL SORT(KPN)
44000	C   SORTS Q ARRAY, PUTS IT BACK INTO RN
44100	23	LL=0
44200	C  TO 'MOVE' INSTEAD OF 'JUSTIFY'
44300		J=1
44400	223	R=CODEN(KWDS,J,RN,K)
44500		IF(R.LE.3.OR.R.EQ.17.OR.R.EQ.18)GO TO 123
44600		J=J+1
44700		GO TO 223
44800	123	R8=ENDLN-RN(K+3)+2
44900	CC	IF(ENDLN.EQ.0)R8=1.-RN(4)
45000		R4=0
45100		R7=0
45200		RS=0
45300		R9=0
45400		R5=10000
45500	C  INSERT??  →→ IF(R8.GT.0)R9=200.
45600	33	CALL PTMOVE(RN,KWDS)
45700	C******* IS KQ SUPPOSED TO BE 0!!!!!!!!?????
45800		CALL SHFT0(KQ)
45900	CCC	ENDLN=ENDLN+200-XLFT
46000	CP	IF(IPG)GO TO 10
46100	20	CALL RESPC
46200		GO TO 1344
46300		END